home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / graphic / tpega.zip / TPDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1986-03-20  |  13KB  |  479 lines
  1. program Demo;
  2.  
  3. {                                                                              }
  4. {   Program:     Demo, Version 01/20/86                                        }
  5. {                                                                              }
  6. {   Description: Demonstrate some of the EGA graphic routines.                 }
  7. {                                                                              }
  8. {   Author:      Kent Cedola                                                   }
  9. {                2015 Meadow Lake Court, Norfolk VA, 23518. 1-(804)-857-0613   }
  10. {                                                                              }
  11. {   Language:    Turbo Pascal, V3.01A                                          }
  12. {                                                                              }
  13. {   Comments:    This program only includes the graphic routines needed to     }
  14. {                save space and time for BBS's.  If you would like a complete  }
  15. {                set of EGA graphic routines (FREE), please let me know.       }
  16. {                                                                              }
  17.  
  18. {$K- }
  19.  
  20. {$I GPPARMS.P }
  21. {$I GPINIT.P  }
  22. {$I GPTERM.P  }
  23. {$I GPCOLOR.P }
  24. {$I GPSTYLE.P }
  25. {$I GPSHADE.P }
  26. {$I GPPAL.P   }
  27. {$I GPPLOT.P  }
  28. {$I GPBOX.P   }
  29. {$I GPBALL.P  }
  30. {$I GPMOVE.P  }
  31. {$I GPLINE.P  }
  32. {$I GPRECT.P  }
  33. {$I GPCIR.P   }
  34. {$I GPFLOOD.P }
  35. {$I GPFILL.P  }
  36. {$I GPWINDOW.P }
  37. {$I GPVIEWPO.P }
  38. {$I GPSCALE.P  }
  39. {$I GPCLIP2.P  }
  40. {$I World.P   }
  41.  
  42. procedure EGACOLOR(color: Integer); external 'PEGA_IO.BIN';
  43. procedure EGAPLOT(X,Y: Integer); external EGACOLOR[3];
  44. procedure EGALINE(X1,Y1,X2,Y2: Integer); external EGACOLOR[6];
  45. procedure EGAFILLRECT(X1,Y1,X2,Y2: Integer); external EGACOLOR[9];
  46.  
  47. var
  48.   x,y:    integer;
  49.   stat:   integer;
  50.   Ch:     char;
  51.  
  52.   buff:   array [0..15] of Byte;
  53.   Shade:  array [0..15] of Byte;
  54.  
  55. procedure InitGraphics;
  56. begin
  57.   GPPARMS;                             { Sets up all global variables  }
  58.  
  59.   if GDTYPE = 4 then                    { Give monochrome user bad news }
  60.     begin
  61.       writeln('Sorry, must have a Color Display not monochrome!');
  62.       halt(1);
  63.     end
  64.   else if GDTYPE <> 5 then              { Tell non-EGA users no can run }
  65.     begin
  66.       writeln('Enhanced Color Adapter and Display not found!');
  67.       halt(2);
  68.     end;
  69.  
  70.   if GDMEMORY = 64 then                 { We need lots of EGA memory    }
  71.     begin
  72.       writeln('This program will work much better with 128k+ EGA memory!');
  73.       writeln('    Hit any key to continue!');
  74.       Read(Kbd,Ch);
  75.    end;
  76.  
  77.   GPINIT;                              { We are now in graphic mode!   }
  78.  
  79.   buff[0] := 4;
  80.   buff[1] := Green;
  81.   buff[2] := Green;
  82.   buff[3] := Blue;
  83.   buff[4] := Blue;
  84.  
  85.   GPSTYLE(buff);
  86.  
  87. end;
  88.  
  89. procedure TermGraphics;
  90. begin
  91.  
  92.   GPTERM;                              { Terminate graphic mode        }
  93.  
  94. end;
  95.  
  96. {
  97.   Example on how to fill(flood) an area on the screen.
  98.  
  99.   Written to test logic for 3-D hidden line removal.  (works).
  100. }
  101.  
  102. procedure TestFill;
  103. begin
  104.  
  105.   GPCOLOR(White);                      { Draw a white line across the screen }
  106.   GPMOVE(0,0);
  107.   GPLINE(GDMAXCOL,GDMAXROW);
  108.  
  109.   GPCOLOR(Red);                        { Draw a Red rectangle }
  110.   GPMOVE(50,50);
  111.   GPRECT(300,100);
  112.  
  113.   Read(KBD,Ch);
  114.  
  115.   GPCOLOR(Green);                      { Fill in the area as GREEN }
  116.   GPMOVE(60,60);      { VERY IMPORTANT: must set starting location }
  117.   GPFLOOD(Red);                        { Red = border for flood }
  118.  
  119.   Read(KBD,Ch);
  120.  
  121.   GPCOLOR(Blue);                       { Fill as Blue }
  122.   GPFLOOD(Red);
  123.  
  124.   Read(KBD,Ch);
  125.  
  126.   GPCOLOR(Red);                        { Fill as Red }
  127.   GPFLOOD(Red);
  128.  
  129.   Read(KBD,Ch);
  130.  
  131. end;
  132.  
  133. procedure TitlePage;
  134. begin { TitlePage }
  135.  
  136.   GPCOLOR(Black);
  137.   GPMOVE(0,0);
  138.   GPBOX(GDMAXCOL,GDMAXROW);
  139.  
  140.   TextColor(Cyan);
  141.   GotoXY( 3,2); Write('KC-TPDEMO Beta');
  142.   GotoXY(24,2); Write('Demonstration of Turbo Pascal & EGA');
  143.   GotoXY(68,2); Write('KC-Graphics');
  144.  
  145.   GPCOLOR(Green);
  146.   GPMOVE(0,0);
  147.   GPRECT(GDMAXCOL,GDMAXROW);
  148.   GPMOVE(4,3);
  149.   GPRECT(GDMAXCOL-4,38);
  150.   GPMOVE(4,41);
  151.   GPRECT(124,346);
  152.   GPMOVE(128,41);
  153.   GPRECT(635,346);
  154.  
  155. end; { TitlePage }
  156.  
  157. procedure MapPage;
  158. const
  159.   World: array [0..1250] of Integer =
  160.     (
  161.     168,2,16,3,16,3,15,4,14,6,14,6,12,8,12,9,10,10,10,12,9,15,9,17,10,
  162.     19,11,25,11,27,12,27,13,30,13,30,12,28,12,28,10,26,10,26,9,28,8,30,8,
  163.     30,9,32,10,32,9,33,9,33,12,31,12,32,13,35,13,35,11,37,9,39,9,36,12,
  164.     39,12,39,10,40,9,43,9,46,12,46,14,43,17,40,15,40,14,42,14,43,13,42,12,
  165.     40,12,40,13,38,14,38,16,34,16,30,19,30,20,33,22,34,22,34,25,37,21,
  166.     36,19,39,17,40,17,41,18,41,19,43,18,44,22,46,23,46,24,45,24,45,25,
  167.     45,26,46,26,46,28,43,27,43,26,45,25,42,25,39,25,40,27,40,30,37,30,
  168.     32,35,32,37,28,39,29,43,28,44,27,43,26,40,24,40,24,41,21,41,18,44,
  169.     18,46,17,47,19,49,21,48,21,46,24,46,22,51,25,51,25,55,28,55,28,56,
  170.     29,56,32,53,35,55,36,54,42,58,44,58,45,60,45,62,47,62,48,64,51,64,
  171.     54,66,54,68,52,71,52,76,48,80,48,83,45,87,45,88,42,91,42,94,43,95,
  172.     43,99,45,100,42,100,43,99,41,100,38,96,35,88,35,83,34,76,30,74,30,73,
  173.     26,66,26,62,28,57,27,56,24,56,22,53,21,53,21,52,19,52,19,51,16,51,
  174.     12,49,13,47,10,40,11,46,10,46,8,42,8,38,7,37,7,32,11,27,12,27,12,26,
  175.     11,24,12,19,9,17,7,18,6,18,6,19,4,19,2,20,2,16,
  176.     5,
  177.     31,8,34,7,35,8,32,9,31,8,
  178.     4,
  179.     34,9,36,9,34,11,34,9,
  180.     5,
  181.     36,7,38,7,38,8,36,8,36,7,
  182.     40,
  183.     42,7,46,4,44,4,43,6,41,6,41,5,44,4,48,2,50,2,51,3,50,4,54,3,58,3,61,1,
  184.     64,1,65,3,67,3,67,4,65,8,64,8,62,10,63,10,63,11,59,12,58,14,57,14,
  185.     53,19,51,18,49,14,51,12,51,11,52,11,52,8,48,8,47,7,50,4,48,4,45,8,
  186.     44,7,42,7,
  187.     6,
  188.     62,13,66,13,67,14,64,16,62,14,62,13,
  189.     7,
  190.     25,46,26,45,28,45,31,47,29,48,29,47,25,46,
  191.     5,
  192.     32,47,34,48,32,49,31,48,32,47,
  193.     5,
  194.     78,5,80,5,81,6,79,7,78,5,
  195.     4,
  196.     81,4,82,4,82,5,81,4,
  197.     4,
  198.     81,6,82,6,82,7,81,6,
  199.     8,
  200.     94,10,94,8,97,6,98,6,98,7,95,9,95,10,94,10,
  201.     9,
  202.     96,70,98,69,98,68,99,67,100,70,98,76,96,77,95,75,96,70,
  203.     5,
  204.     140,20,143,23,143,25,142,25,140,20,
  205.     5,
  206.     143,26,145,26,146,27,144,29,143,26,
  207.     9,
  208.     145,29,147,30,147,33,143,36,142,35,144,34,142,34,145,32,145,29,
  209.     5,
  210.     139,40,140,40,140,43,139,42,139,40,
  211.     7,
  212.     140,46,141,45,142,48,143,50,142,50,139,48,140,46,
  213.     4,
  214.     140,51,140,52,139,53,140,51,
  215.     4,
  216.     142,50,143,52,142,52,142,50,
  217.     10,
  218.     144,52,145,53,144,56,143,55,143,54,142,54,142,53,142,52,143,52,144,52,
  219.     9,
  220.     138,54,140,54,140,60,138,62,135,62,134,60,134,57,136,57,138,54,
  221.     8,
  222.     141,58,144,58,144,59,142,59,143,64,141,64,140,62,141,58,
  223.     5,
  224.     145,58,146,58,146,59,145,59,145,58,
  225.     15,
  226.     147,59,149,59,150,60,152,60,156,62,158,64,160,64,158,66,160,68,157,68,
  227.     155,66,152,67,151,64,148,62,147,59,
  228.     4,
  229.     143,66,140,66,140,67,141,67,
  230.     2,
  231.     143,67,144,66,
  232.     13,
  233.     160,86,162,86,163,90,160,93,159,92,154,96,152,96,152,95,158,91,
  234.     159,92,159,90,161,89,160,86,
  235.     26,
  236.     133,85,134,83,134,76,136,74,138,74,143,70,145,70,148,68,150,68,
  237.     150,70,152,72,153,68,154,68,156,76,158,78,152,88,146,89,148,90,
  238.     148,91,146,92,146,89,144,84,139,84,139,85,134,85,133,84,
  239.     10,
  240.     126,55,127,55,133,61,132,65,136,66,137,65,136,64,131,64,126,57,126,55,
  241.     9,
  242.     68,20,70,19,71,20,71,22,72,23,72,24,68,25,69,22,68,20,
  243.     5,
  244.     68,22,68,24,66,24,67,22,68,22,
  245.     178,
  246.     65,36,60,44,60,52,66,57,74,57,74,60,77,64,77,68,76,70,76,73,81,83,
  247.     86,83,91,76,91,73,94,70,94,66,93,64,93,62,100,54,100,51,96,52,
  248.     92,47,90,40,94,46,96,50,100,49,102,48,105,44,103,42,108,42,110,45,
  249.     112,45,113,52,115,55,116,55,117,52,117,55,118,55,118,53,117,52,
  250.     118,48,122,44,127,51,127,53,130,58,132,58,132,57,128,52,128,50,
  251.     132,54,134,52,134,50,132,46,132,44,136,44,138,42,139,36,136,34,
  252.     136,32,134,32,134,30,137,30,139,34,140,34,141,33,139,30,139,28,
  253.     141,28,141,28,136,18,136,16,141,16,141,14,143,14,143,18,147,21,
  254.     148,20,145,15,148,12,147,10,150,10,149,8,146,8,144,7,138,7,138,8,
  255.     134,8,134,7,126,7,